home *** CD-ROM | disk | FTP | other *** search
/ Dr. Windows 3 / dr win3.zip / dr win3 / VISUALBA / BOZOL2.ZIP / BTREE.BAS < prev    next >
BASIC Source File  |  1994-02-08  |  21KB  |  727 lines
  1. 'PUBLIC Act.Keys$, BT.Update.Always%
  2. ' be sure that you have the above PUBLIC statement near the top of
  3. ' the calling program.
  4. 'EXTERNAL Act.Keys$, BT.Update.Always%
  5. ' and put this line at the top of this file if you are creating a unit,
  6. ' otherwise, PUBLIC and EXTERNAL are not necessary with include files
  7. Sub BT(FileName$,Action$,SKy$,SDta$,RKy$,RDta$,RCCODE%) PUBLIC
  8.   Static Keys$(),Ptr$(),Stk%(),Itm$(),Dta$(),LastFile$,Cur.Lvl%,_
  9.          Hlf.Node$,Hlf.Node%,Key.Len$,Key.Len%,Dta.Len$,Dta.Len%,_
  10.          Itm.Len$,Itm.Len%,CCODE$,Root.Node$,Root.Rec%,Nxt.Node$,_
  11.          Nxt.Node%,Lst.Del$,Lst.Del%,Num.Act$,Num.Act%,Num.Keys$,_
  12.          Keys.Act%,Itm.Ptr%,Cur.Rec%
  13.  
  14.   %BT.Max.Half.Node = 15
  15.   %BT.Max.Node = %BT.Max.Half.Node * 2
  16.   %BT.File.Num = 2801
  17.  
  18.   DIM    Keys$(0:%BT.Max.Node),Ptr$(0:%BT.Max.Node),Stk%(0:10,0:1),_
  19.          Itm$(0:%BT.Max.Node),Dta$(0:%BT.Max.Node)
  20.  
  21.   UsrAct$ = Ucase$(Left$(Action$+" ",1))
  22.   If UsrAct$ = "C" Then
  23.     Gosub BT.Create
  24.   Else
  25.     Status% = -1
  26.     If UsrAct$ <> "Q" Then
  27.       If Ucase$(FileName$) <> Ucase$(LastFile$) then Gosub BT.Open.New
  28.       If LastFile$ = "" Then Status% = 0
  29.     End if
  30.     If Status% Then
  31.       Select Case UsrAct$
  32.         Case "F"  'Get First Key
  33.           Cur.Lvl% = 0
  34.           Gosub Bt.Get.Next
  35.         Case "L"  'Get Last Key
  36.           Cur.Lvl% = 0
  37.           Gosub Bt.Get.Prev
  38.         Case "S"  'Search for key in Ky$
  39.           Ky$ = Sky$
  40.           Gosub Bt.Search
  41.         Case "A"  'Add a non-unique key
  42.           Ky$ = Sky$
  43.           Da$ = SDta$
  44.           Gosub BT.Add.Non.Unique
  45.         Case "U"  'Add a unique key
  46.           Ky$ = Sky$
  47.           Da$ = Sdta$
  48.           Gosub BT.Add.Unique
  49.         Case "D"  'Delete the key/data given
  50.           Ky$ = Sky$
  51.           Gosub BT.Search
  52.           Do Until Status% = 0
  53.             If Ky$ <> Keys$(Itm.Ptr%) Then
  54.               Status% = 0
  55.               Exit Loop
  56.             End if
  57.             If SDta$ = Dta$(Itm.Ptr%) Then
  58.               Gosub BT.Del.Cur
  59.               Status% = -1
  60.               Exit Loop
  61.             Else
  62.               Gosub BT.Get.Next
  63.             End if
  64.           Loop
  65.         Case "N"  'Get Next Key
  66.           Gosub BT.Get.Next
  67.         Case "P"  'Get Previous Key
  68.           Gosub Bt.Get.Prev
  69.         Case "Q"
  70.           If LastFile$="" then
  71.             Status% =  0
  72.           Else
  73.             Status% = -1
  74.           End if
  75.         Case Else 'Error in Action CCODE
  76.           Rky$ = ""
  77.           RdTmp.Add$= ""
  78.           Status% = 0
  79.       End Select
  80.     End if
  81.     If Instr("AUDQ",UsrAct$) And Status% And (BT.Update.Always% or UsrAct$="Q") Then
  82.       Gosub BT.Update.Stats
  83.       Call UpdateFile(%BT.File.Num)
  84.       If UsrAct$ = "Q" Then
  85.         Close %BT.File.Num
  86.         LastFile$ = ""
  87.       End if
  88.     End if
  89.   End if
  90.   Rky$ = Keys$(Itm.Ptr%)
  91.   Rdta$= Dta$(Itm.Ptr%)
  92.   RCCODE% = Status%
  93.   Exit Sub
  94.  
  95. BT.Open.New:
  96.   If LastFile$ <> "" Then Gosub BT.Update.Stats
  97.   Close %BT.File.Num
  98.   Open FileName$ FOR RANDOM SHARED AS #%BT.File.Num LEN=256
  99.   Gosub Bt.Get.Stats
  100.   If Status% = 0 Then
  101.     LastFile$ = ""
  102.     Close %BT.File.Num
  103.   Else
  104.     LastFile$ = FileName$
  105.     Gosub BT.Get.Stats
  106.     Gosub Bt.Field.Node
  107.   End if
  108.   Return
  109.  
  110. BT.Create:
  111.   Close %BT.File.Num
  112.   Hlf.Node% = ( (253 \ (Len(SKy$) + Len(SDta$) + 2)) \ 2 )
  113.   If Hlf.Node% < 1 Then
  114.     Status% = 0
  115.     LastFile$ = ""
  116.     Return
  117.   End if
  118.   If Hlf.Node% > %BT.Max.Half.Node then Hlf.Node% = %BT.Max.Half.Node
  119.   Open "O",%BT.File.Num,FileName$
  120.   Close %BT.File.Num
  121.   Open "R",%BT.File.Num,FileName$,256
  122.   Gosub BT.Field.Stats
  123.   Lset Hlf.Node$ = MKI$(Hlf.Node%)
  124.   Lset Key.Len$ = MKI$(Len(SKy$))
  125.   Lset Dta.Len$ = MKI$(Len(SDta$))
  126.   Lset Itm.Len$ = MKI$(Len(SKy$) + Len(SDta$) + 2)
  127.   Lset CCODE$ = "BT"
  128.   Lset Root.Node$ = MKI$(2)
  129.   Lset Nxt.Node$ = MKI$(3)
  130.   Lset Lst.Del$ = MKI$(0)
  131.   Lset Num.Act$ = MKI$(1)
  132.   Lset Num.Keys$ = MKI$(0)
  133.   Put %BT.File.Num,1
  134.   Status% = -1
  135.   Close %BT.File.Num
  136.   LastFile$ = ""
  137.   Return
  138.  
  139. BT.GET.STATS:
  140.   GOSUB BT.Field.STATS
  141.   If CCODE$ <> "BT" Then
  142.     Status% = 0
  143.     LastFile$ = ""
  144.   Else
  145.     Status% = -1
  146.     Hlf.Node%=CVI(Hlf.Node$)
  147.     Key.Len%=CVI(Key.Len$)
  148.     Dta.Len%=CVI(Dta.Len$)
  149.     Itm.Len%=CVI(Itm.Len$)
  150.     Root.Rec%=CVI(Root.Node$)
  151.     Nxt.Node%=CVI(Nxt.Node$)
  152.     Lst.Del%=CVI(Lst.Del$)
  153.     Num.Act%=CVI(Num.Act$)
  154.     Keys.Act%=CVI(Num.Keys$)
  155.   End if
  156.   RETURN
  157.  
  158. BT.Field.STATS:
  159.   FIELD %BT.File.Num,2 AS Hlf.Node$,2 AS Key.Len$,2 AS Dta.Len$,2 AS Itm.Len$, _
  160.   2 AS CCODE$,2 AS Root.Node$,2 AS Nxt.Node$,2 AS Lst.Del$,2 AS Num.Act$,_
  161.   2 AS Num.Keys$
  162.   Cur.Rec%=1
  163.   GOSUB BT.GET.CUR
  164.   RETURN
  165.  
  166. BT.FIELD.NODE:
  167.   FIELD %BT.File.Num,1 AS Act.Keys$,2 AS Ptr$(0)
  168.   FOR Cnt%=1 TO Hlf.Node%*2
  169.     FIELD %BT.File.Num,3+Itm.Len%*(Cnt%-1) AS Tmp2$,(Key.Len%) AS Keys$(Cnt%),_
  170.     (Dta.Len%) AS Dta$(Cnt%),2 AS Ptr$(Cnt%)
  171.     FIELD %BT.File.Num,3+Itm.Len%*(Cnt%-1) AS Tmp2$,(Itm.Len%) AS Itm$(Cnt%)
  172.   NEXT Cnt%
  173.   RETURN
  174.  
  175. BT.GET.STACK.NODE:
  176.   Cur.Rec%=Stk%(Cur.Lvl%,0)
  177.   Itm.Ptr%=Stk%(Cur.Lvl%,1)
  178.   GOSUB BT.GET.CUR
  179.   RETURN
  180.  
  181. BT.POP:
  182.   Decr Cur.Lvl%
  183.   GOSUB BT.GET.STACK.NODE
  184.   RETURN
  185.  
  186. BT.PUSH:
  187.   Stk%(Cur.Lvl%,0)=Cur.Rec%
  188.   Stk%(Cur.Lvl%,1)=Itm.Ptr%
  189.   RETURN
  190.  
  191. BT.Update.Stats:
  192.   Cur.Rec%=1
  193.   GET %BT.File.Num,Cur.Rec%
  194.   LSET Root.Node$=MKI$(Root.Rec%)
  195.   LSET Nxt.Node$=MKI$(Nxt.Node%)
  196.   LSET Lst.Del$=MKI$(Lst.Del%)
  197.   LSET Num.Act$=MKI$(Num.Act%)
  198.   LSET Num.Keys$=MKI$(Keys.Act%)
  199.   PUT %BT.File.Num,Cur.Rec%
  200.   RETURN
  201.  
  202. BT.GET.CUR:
  203.   If Cur.Rec% * 256 > Lof(%BT.File.Num) Then
  204.     Field %BT.File.Num,256 as Dmy$
  205.     Lset Dmy$ = String$(256,0)
  206.     Put %BT.File.Num,Cur.Rec%
  207.   End if
  208.   GET %BT.File.Num,Cur.Rec%
  209.   RETURN
  210.  
  211. '*** SEARCH FOR FIRST OCCURANCE OF KEY ***
  212.  
  213. BT.SEARCH:
  214.   Temp%=0
  215. BT.NON.UNQ:
  216.   Status%=0
  217.   Cur.Lvl%=1
  218.   Cur.Rec%=Root.Rec%
  219.   IF LEN(KY$)<>Key.Len% THEN KY$=LEFT$(KY$+STRING$(Key.Len%," "),Key.Len%)
  220. BT.SCAN.NODE:
  221.   GOSUB BT.GET.CUR
  222.   Itm.Ptr%=1
  223.   Cnt%=ASC(Act.Keys$)
  224. BT.S.N.LOOP:
  225.   Wrk.Hlf%=INT((Itm.Ptr%+Cnt%)/2)
  226.   IF KY$>Keys$(Wrk.Hlf%) OR (Temp%<0 AND KY$=Keys$(Wrk.Hlf%)) THEN_
  227.     Itm.Ptr%=Wrk.Hlf%+1 ELSE Cnt%=Wrk.Hlf%-1
  228.   IF Cnt%>=Itm.Ptr% THEN
  229.     GOTO BT.S.N.LOOP
  230.   ELSE
  231.     GOSUB BT.PUSH
  232.     IF Itm.Ptr%<=ASC(Act.Keys$) THEN
  233.       IF KY$=Keys$(Itm.Ptr%) THEN
  234.         Status%=-1
  235.         IF CVI(Ptr$(Itm.Ptr%-1))=0 THEN RETURN
  236.       END IF
  237.     END IF
  238.   END IF
  239.   IF CVI(Ptr$(Itm.Ptr%-1))>0 THEN
  240.     Cur.Rec%=CVI(Ptr$(Itm.Ptr%-1))
  241.     Incr Cur.Lvl%
  242.     GOTO BT.SCAN.NODE
  243.   END IF
  244.   IF Status% THEN BT.GN.L.SON
  245.   If Temp% = 0 Then
  246.     Gosub BT.GN.OK
  247.     Status% = 0
  248.   End if
  249.   RETURN
  250.  
  251.  
  252.  
  253. '*** ADD KEY AT CURRENT NODE LOCATION ***
  254.  
  255. BT.ADD.AT.CUR:
  256.   Tmp.Add$=LEFT$(KY$+STRING$(Key.Len%," "),Key.Len%)+LEFT$(DA$+STRING$(Dta.Len%," "),Dta.Len%)+MKI$(0)
  257.   Temp%=0
  258. BT.CHK.FULL:
  259.   IF ASC(Act.Keys$)<Hlf.Node%*2 THEN
  260.     LSET Act.Keys$=CHR$(ASC(Act.Keys$)+1)
  261.     Cnt%=ASC(Act.Keys$)
  262.     GOSUB BT.INS.IN.NODE
  263.     LSET Ptr$(Itm.Ptr%-1)=MKI$(Temp%)
  264.     PUT %BT.File.Num,Cur.Rec%
  265.     Keys.Act%=Keys.Act%+1
  266.     Tmp.Add$=""
  267.     Temp$=""
  268.     Emerg$=""
  269.     Status% = -1
  270.     RETURN
  271.   END IF
  272.   IF Itm.Ptr%>Hlf.Node%+1 THEN
  273.     GOTO BT.ADD.RIGHT
  274.   ELSEIF Itm.Ptr%=Hlf.Node%+1 Then
  275.     Emerg$=Tmp.Add$
  276.   ELSE
  277.     Emerg$=Itm$(Hlf.Node%)
  278.     Cnt%=Hlf.Node%
  279.     GOSUB BT.INS.IN.NODE
  280.   END IF
  281.   LSET Ptr$(Itm.Ptr%-1)=MKI$(Temp%)
  282.   LSET Act.Keys$=CHR$(Hlf.Node%)
  283.   FIELD %BT.File.Num,3+Hlf.Node%*(Itm.Len%) AS Tmp2$,Hlf.Node%*(Itm.Len%) AS Tmp2$
  284.   Temp$=Tmp2$
  285.   PUT %BT.File.Num,Cur.Rec%
  286.   Temp%=Cur.Rec%
  287.   GOSUB BT.GET.AVAIL.NODE
  288.   GOSUB BT.SET.COPY
  289.   GOSUB BT.SET.RGHT.SON
  290.   GOTO BT.WRT.NODE
  291. BT.ADD.RIGHT:
  292.   FIELD %BT.File.Num,1 AS Tmp2$,2+Hlf.Node%*(Itm.Len%) AS Tmp2$
  293.   Temp$=Tmp2$
  294.   Itm.Ptr%=Itm.Ptr%-Hlf.Node%
  295.   Emerg$=Itm$(Hlf.Node%+1)
  296.   FOR Cnt%=1 TO Itm.Ptr%-2
  297.     LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%+1)
  298.   NEXT Cnt%
  299.   LSET Itm$(Itm.Ptr%-1)=Tmp.Add$
  300.   IF Itm.Ptr%>Hlf.Node% THEN
  301.     GOTO BT.SET.LFT.SON
  302.   ELSE
  303.     FOR Cnt%=Itm.Ptr% TO Hlf.Node%
  304.       LSET Itm$(Cnt%)=Itm$(Cnt%+Hlf.Node%)
  305.     NEXT Cnt%
  306.   END IF
  307. BT.SET.LFT.SON:
  308.   GOSUB BT.SET.R